A1
2024-07-28
require(readxl)## Loading required package: readxlrequire(xts)## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericrequire(readr)## Loading required package: readrrequire(tidyverse)## Loading required package: tidyverse## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ purrr 1.0.2
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks xts::first()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks xts::last()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsrequire(broom)## Loading required package: broomrequire(stargazer)## Loading required package: stargazer
##
## Please cite as:
##
## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.
## R package version 5.2.3. https://CRAN.R-project.org/package=stargazerrequire(tidyquant)## Loading required package: tidyquant
## Loading required package: PerformanceAnalytics
##
## Attaching package: 'PerformanceAnalytics'
##
## The following object is masked from 'package:graphics':
##
## legend
##
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoorequire(purrr)
require(tidyr)
require(dplyr)
require(quantmod)
require(PerformanceAnalytics)
require(PortfolioAnalytics)## Loading required package: PortfolioAnalytics
## Loading required package: foreach
##
## Attaching package: 'foreach'
##
## The following objects are masked from 'package:purrr':
##
## accumulate, when
##
## Registered S3 method overwritten by 'PortfolioAnalytics':
## method from
## print.constraint ROIrequire(TTR)
require(DEoptim)## Loading required package: DEoptim
## Loading required package: parallel
##
## DEoptim package
## Differential Evolution algorithm in R
## Authors: D. Ardia, K. Mullen, B. Peterson and J. Ulrichrequire(ROI)## Loading required package: ROI
## ROI: R Optimization Infrastructure
## Registered solver plugins: nlminb, symphony, glpk, quadprog.
## Default solver: auto.
##
## Attaching package: 'ROI'
##
## The following objects are masked from 'package:PortfolioAnalytics':
##
## is.constraint, objective#require(qmao)
require(zoo)
require(quadprog)## Loading required package: quadprogrequire(corrplot)## Loading required package: corrplot
## corrplot 0.92 loadedrequire(ggplot2)
require(foreach)
#install.packages("ROI.plugin.quadprog")
library(ROI.plugin.quadprog)
#install.packages("ROI.plugin.glpk")
library(ROI.plugin.glpk)
library(reshape2)##
## Attaching package: 'reshape2'
##
## The following object is masked from 'package:tidyr':
##
## smithslibrary(quantmod)path <- "/Users/rgkeat/downloads/tradingProgramming/port1.xlsx"
port1 <- read_xlsx(path)
path <- "/Users/rgkeat/downloads/tradingProgramming/port2.xlsx"
port2 <- read_xlsx(path)port2 <- merge(port1, port2, by = "date", all = TRUE)# Convert into df
port1 <- data.frame(port1)
port2 <- data.frame(port2)
head(port1)## date acen allhc apx bpi cnpf cnvrg fgen jgs meg pxp
## 1 2023-12-29 4.3342 1.77 23.763 103.8 31.05 8.38 17.40 38.15 1.97 3.95
## 2 2023-12-28 4.2352 1.74 24.490 104.5 31 8.51 17.42 40.00 1.96 4.10
## 3 2023-12-27 4.1165 1.71 23.589 103.5 31.8 8.49 17.00 40.20 1.95 3.95
## 4 2023-12-22 4.1066 1.7 23.914 104.1 30.55 8.26 17.26 40.70 1.97 3.63
## 5 2023-12-21 3.6712 1.68 23.784 104.6 31.9 8.00 17.50 41.00 1.95 3.77
## 6 2023-12-20 3.9878 1.7 26.996 103.3 31.05 7.84 17.50 42.00 1.96 3.70# Convert to numeric except date
port1[, -1] <- lapply(port1[, -1], function(x) as.numeric(as.character(x)))## Warning in FUN(X[[i]], ...): NAs introduced by coercion
## Warning in FUN(X[[i]], ...): NAs introduced by coercionport2[, -1] <- lapply(port2[, -1], function(x) as.numeric(as.character(x)))## Warning in FUN(X[[i]], ...): NAs introduced by coercion
## Warning in FUN(X[[i]], ...): NAs introduced by coercion# Drop missing
port1 <- na.omit(port1)
port2 <- na.omit(port2)
#port1 <- port1[complete.cases(port1), ]
#port2 <- port2[complete.cases(port2), ]
sum(is.na(port1))## [1] 0sum(is.na(port2))## [1] 0port1 <- xts(port1[,-1], order.by = as.Date(port1$date))
port2 <- xts(port2[,-1], order.by = as.Date(port2$date))
head(port1)## acen allhc apx bpi cnpf cnvrg fgen jgs meg pxp
## 2015-01-05 2.0173 0.65 23.180 84.7861 16.30 13.83 26.00 65.6316 4.7516 5.06
## 2015-01-09 2.1130 0.70 21.948 82.8226 16.86 13.87 26.35 66.5353 5.1171 5.35
## 2015-01-12 2.1130 0.69 22.056 83.0011 16.72 15.96 26.35 64.2049 5.1270 5.07
## 2015-01-13 2.1478 0.69 22.258 83.6259 16.90 13.89 26.05 64.6805 5.1171 5.09
## 2015-01-14 2.1217 0.70 21.376 83.4474 17.22 13.90 26.20 66.5828 5.3246 5.09
## 2015-01-19 2.1217 0.70 21.854 83.8936 17.08 13.91 26.25 66.7731 5.2159 5.09port1ret <- PerformanceAnalytics::Return.calculate(port1,method="log")
port1ret <- port1ret[-1]port2ret <- PerformanceAnalytics::Return.calculate(port2,method="log")
port2ret <- port2ret[-1]sum(is.na(port1ret))## [1] 0sum(is.na(port2ret))## [1] 0EDA
~~~~~~~~~~~~~~~~~~~~~~~~~~~
riskTable10 <- data.frame(port1)
riskTable10 <- riskTable10[complete.cases(riskTable10), ]
rfRate <- 0.06275
means10 <- colMeans(riskTable10)
risks10 <- apply(riskTable10, 2, sd)
sharpe10 <- ifelse(risks10 != 0, (means10 - rfRate) / risks10, NA)
riskReturnBasket10 <- data.frame(Asset = names(means10),Mean_Return = means10,Risk = risks10,Sharpe_Ratio = sharpe10)
print(riskReturnBasket10)## Asset Mean_Return Risk Sharpe_Ratio
## acen acen 3.748714 2.887271 1.276626
## allhc allhc 2.710329 1.094981 2.417921
## apx apx 346.699770 314.136266 1.103461
## bpi bpi 84.898088 11.783242 7.199660
## cnpf cnpf 19.175530 4.460263 4.285124
## cnvrg cnvrg 16.747700 5.072439 3.289335
## fgen fgen 22.116313 4.760666 4.632454
## jgs jgs 61.517842 10.827602 5.675781
## meg meg 3.837497 1.147843 3.288558
## pxp pxp 6.703502 4.017545 1.652938riskTable20 <- data.frame(port2)
riskTable20 <- riskTable20[complete.cases(riskTable20), ]
means20 <- colMeans(riskTable20)
risks20 <- apply(riskTable20, 2, sd)
sharpe20 <- ifelse(risks20 != 0, (means20 - rfRate) / risks20, NA)
riskReturnBasket20 <- data.frame(Asset = names(means20),Mean_Return = means20,Risk = risks20,Sharpe_Ratio = sharpe20)
print(riskReturnBasket20)## Asset Mean_Return Risk Sharpe_Ratio
## acen acen 3.787410 2.904394 1.282422
## allhc allhc 2.737248 1.087549 2.459199
## apx apx 352.895470 314.318725 1.122532
## bpi bpi 84.916748 11.856934 7.156487
## cnpf cnpf 19.199191 4.500416 4.252149
## cnvrg cnvrg 16.774920 5.120671 3.263668
## fgen fgen 22.049995 4.763177 4.616088
## jgs jgs 61.384410 10.880322 5.636015
## meg meg 3.818486 1.149075 3.268487
## pxp pxp 6.793683 4.004777 1.680726
## agi agi 13.034033 3.832082 3.384918
## ali ali 36.639196 6.336923 5.771957
## bdo bdo 102.705215 18.012257 5.698479
## cbc cbc 26.974836 4.150415 6.484191
## ict ict 126.366836 49.895551 2.531370
## mac mac 6.945194 5.378371 1.279652
## nikl nikl 3.678322 1.644371 2.198757
## psei psei 7164.723934 723.138016 9.907737
## smc smc 112.266596 32.543852 3.447774
## wlcon wlcon 15.540061 8.558641 1.808384summary_returns_10 <- table.Stats(port1ret)
print(summary_returns_10)## acen allhc apx bpi cnpf cnvrg
## Observations 2158.0000 2158.0000 2158.0000 2158.0000 2158.0000 2158.0000
## NAs 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
## Minimum -0.1551 -0.2490 -0.3816 -0.1156 -0.3753 -0.1598
## Quartile 1 -0.0118 -0.0113 -0.0177 -0.0087 -0.0074 -0.0111
## Median 0.0000 0.0000 0.0002 0.0000 0.0000 0.0000
## Arithmetic Mean 0.0004 0.0005 0.0000 0.0001 0.0003 -0.0002
## Geometric Mean 0.0000 0.0001 -0.0009 -0.0001 0.0001 -0.0007
## Quartile 3 0.0101 0.0109 0.0192 0.0092 0.0083 0.0125
## Maximum 0.1499 0.3009 0.2557 0.0940 0.1479 0.1404
## SE Mean 0.0006 0.0006 0.0009 0.0004 0.0004 0.0007
## LCL Mean (0.95) -0.0007 -0.0008 -0.0017 -0.0007 -0.0006 -0.0015
## UCL Mean (0.95) 0.0014 0.0017 0.0017 0.0009 0.0012 0.0011
## Variance 0.0007 0.0008 0.0017 0.0003 0.0004 0.0009
## Stdev 0.0258 0.0288 0.0410 0.0180 0.0204 0.0305
## Skewness 0.4644 0.9321 -1.4207 -0.2420 -3.5594 -0.1420
## Kurtosis 4.2789 13.9318 16.1447 4.4019 65.8219 4.4294
## fgen jgs meg pxp
## Observations 2158.0000 2158.0000 2158.0000 2158.0000
## NAs 0.0000 0.0000 0.0000 0.0000
## Minimum -0.1061 -0.1583 -0.1965 -0.2536
## Quartile 1 -0.0100 -0.0137 -0.0125 -0.0208
## Median 0.0000 0.0000 0.0000 -0.0029
## Arithmetic Mean -0.0002 -0.0003 -0.0004 -0.0001
## Geometric Mean -0.0004 -0.0006 -0.0007 -0.0011
## Quartile 3 0.0087 0.0136 0.0117 0.0148
## Maximum 0.1323 0.1212 0.0809 0.4055
## SE Mean 0.0004 0.0005 0.0005 0.0010
## LCL Mean (0.95) -0.0011 -0.0013 -0.0013 -0.0020
## UCL Mean (0.95) 0.0007 0.0008 0.0005 0.0018
## Variance 0.0004 0.0006 0.0005 0.0021
## Stdev 0.0205 0.0244 0.0220 0.0458
## Skewness 0.4203 -0.2411 -0.5600 1.8956
## Kurtosis 4.1203 2.5280 4.6704 13.6396summary_returns_20 <- table.Stats(port2ret)
print(summary_returns_20)## acen allhc apx bpi cnpf cnvrg
## Observations 2114.0000 2114.0000 2114.0000 2114.0000 2114.0000 2114.0000
## NAs 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
## Minimum -0.1551 -0.2490 -0.3816 -0.1156 -0.3753 -0.1598
## Quartile 1 -0.0119 -0.0115 -0.0178 -0.0086 -0.0076 -0.0114
## Median 0.0000 0.0000 0.0002 0.0000 0.0000 0.0000
## Arithmetic Mean 0.0004 0.0005 0.0000 0.0001 0.0003 -0.0002
## Geometric Mean 0.0000 0.0000 -0.0009 -0.0001 0.0001 -0.0007
## Quartile 3 0.0105 0.0110 0.0194 0.0095 0.0085 0.0128
## Maximum 0.1499 0.3009 0.2557 0.0940 0.1479 0.1432
## SE Mean 0.0006 0.0006 0.0009 0.0004 0.0004 0.0007
## LCL Mean (0.95) -0.0007 -0.0008 -0.0018 -0.0007 -0.0006 -0.0015
## UCL Mean (0.95) 0.0015 0.0017 0.0018 0.0009 0.0012 0.0011
## Variance 0.0007 0.0009 0.0017 0.0003 0.0004 0.0009
## Stdev 0.0260 0.0293 0.0414 0.0181 0.0206 0.0307
## Skewness 0.4604 0.7938 -1.3726 -0.2597 -3.5337 -0.1401
## Kurtosis 4.2396 14.5140 15.8733 4.3387 64.6999 4.4012
## fgen jgs meg pxp agi ali
## Observations 2114.0000 2114.0000 2114.0000 2114.0000 2114.0000 2114.0000
## NAs 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
## Minimum -0.1061 -0.1583 -0.1965 -0.2536 -0.3432 -0.2271
## Quartile 1 -0.0100 -0.0139 -0.0126 -0.0209 -0.0109 -0.0120
## Median 0.0000 0.0000 0.0000 -0.0028 0.0000 0.0000
## Arithmetic Mean -0.0002 -0.0003 -0.0004 -0.0001 -0.0003 0.0000
## Geometric Mean -0.0004 -0.0006 -0.0007 -0.0011 -0.0006 -0.0002
## Quartile 3 0.0089 0.0138 0.0116 0.0149 0.0101 0.0118
## Maximum 0.1323 0.1212 0.1048 0.4055 0.0907 0.1363
## SE Mean 0.0005 0.0005 0.0005 0.0010 0.0005 0.0005
## LCL Mean (0.95) -0.0011 -0.0013 -0.0014 -0.0021 -0.0013 -0.0009
## UCL Mean (0.95) 0.0007 0.0008 0.0005 0.0018 0.0006 0.0009
## Variance 0.0004 0.0006 0.0005 0.0021 0.0005 0.0005
## Stdev 0.0207 0.0246 0.0223 0.0461 0.0218 0.0218
## Skewness 0.3555 -0.2292 -0.5359 1.8785 -1.8345 -0.6989
## Kurtosis 4.2621 2.4631 4.9878 13.5421 30.5648 8.3124
## bdo cbc ict mac nikl psei
## Observations 2114.0000 2114.0000 2114.0000 2114.0000 2114.0000 2114.0000
## NAs 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
## Minimum -0.2578 -0.0975 -0.1730 -0.2299 -0.1750 -0.1432
## Quartile 1 -0.0096 -0.0033 -0.0111 -0.0135 -0.0163 -0.0067
## Median 0.0000 0.0000 0.0000 0.0000 0.0000 0.0002
## Arithmetic Mean 0.0002 0.0000 0.0004 0.0005 -0.0001 -0.0001
## Geometric Mean 0.0000 -0.0001 0.0001 -0.0002 -0.0006 -0.0001
## Quartile 3 0.0107 0.0032 0.0108 0.0128 0.0149 0.0064
## Maximum 0.1458 0.0834 0.0974 0.2612 0.4055 0.0717
## SE Mean 0.0004 0.0002 0.0005 0.0008 0.0007 0.0003
## LCL Mean (0.95) -0.0007 -0.0005 -0.0006 -0.0011 -0.0014 -0.0006
## UCL Mean (0.95) 0.0011 0.0004 0.0013 0.0020 0.0012 0.0005
## Variance 0.0004 0.0001 0.0005 0.0014 0.0010 0.0002
## Stdev 0.0200 0.0098 0.0222 0.0372 0.0315 0.0124
## Skewness -0.9862 -0.3055 -0.3750 0.2102 0.9614 -1.1433
## Kurtosis 17.7929 14.8756 4.7303 9.4049 15.1494 13.7721
## smc wlcon
## Observations 2114.0000 2114.0000
## NAs 0.0000 0.0000
## Minimum -0.2382 -0.1754
## Quartile 1 -0.0068 -0.0085
## Median 0.0000 0.0000
## Arithmetic Mean 0.0001 0.0007
## Geometric Mean 0.0000 0.0004
## Quartile 3 0.0063 0.0095
## Maximum 0.1431 0.1320
## SE Mean 0.0004 0.0005
## LCL Mean (0.95) -0.0007 -0.0002
## UCL Mean (0.95) 0.0009 0.0016
## Variance 0.0003 0.0004
## Stdev 0.0186 0.0211
## Skewness -0.7516 -0.3708
## Kurtosis 23.4045 7.7614correlation_matrix_returns_10 <- cor(port1ret, use = "complete.obs")
print(correlation_matrix_returns_10)## acen allhc apx bpi cnpf
## acen 1.000000000 0.227599634 0.007509776 0.19427623 0.08215916
## allhc 0.227599634 1.000000000 -0.003962323 0.14909309 0.09513788
## apx 0.007509776 -0.003962323 1.000000000 -0.01975470 -0.03459959
## bpi 0.194276226 0.149093095 -0.019754703 1.00000000 0.13050732
## cnpf 0.082159158 0.095137878 -0.034599588 0.13050732 1.00000000
## cnvrg 0.072737551 0.048080989 -0.002714109 0.05138582 0.05225048
## fgen 0.163503119 0.127271610 0.036634047 0.17119208 0.12609634
## jgs 0.202603665 0.152035496 -0.010215449 0.33610167 0.11646671
## meg 0.218832101 0.220596410 -0.005434654 0.29172897 0.11305230
## pxp 0.098143537 0.129080911 -0.007953490 0.07642520 0.05815896
## cnvrg fgen jgs meg pxp
## acen 0.072737551 0.16350312 0.20260366 0.218832101 0.09814354
## allhc 0.048080989 0.12727161 0.15203550 0.220596410 0.12908091
## apx -0.002714109 0.03663405 -0.01021545 -0.005434654 -0.00795349
## bpi 0.051385821 0.17119208 0.33610167 0.291728966 0.07642520
## cnpf 0.052250476 0.12609634 0.11646671 0.113052296 0.05815896
## cnvrg 1.000000000 0.02619727 0.05132303 0.035024642 0.01603083
## fgen 0.026197274 1.00000000 0.19337177 0.218543710 0.12033716
## jgs 0.051323030 0.19337177 1.00000000 0.362528193 0.11649192
## meg 0.035024642 0.21854371 0.36252819 1.000000000 0.13551428
## pxp 0.016030834 0.12033716 0.11649192 0.135514280 1.00000000corrplot(correlation_matrix_returns_10, method = "color")
melted_correlation_matrix <- melt(correlation_matrix_returns_10)
ggplot(melted_correlation_matrix, aes(x=Var1, y=Var2, fill=value)) +
geom_tile() +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0) +
theme_minimal() +
labs(title = "Correlation Matrix Heatmap", x = "Assets", y = "Assets")
all_returns <- merge(port1ret, port2ret)
all_returns_corr <- data.frame(port1ret = rnorm(100), port2ret = rnorm(100))correlation_matrix <- cor(all_returns_corr)
print(correlation_matrix)## port1ret port2ret
## port1ret 1.00000000 0.05693557
## port2ret 0.05693557 1.00000000corrplot(correlation_matrix, method = "color")
melted_correlation_matrix <- melt(correlation_matrix)
ggplot(melted_correlation_matrix, aes(x=Var1, y=Var2, fill=value)) +
geom_tile() +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0) +
theme_minimal() +
labs(title = "Correlation Matrix Heatmap", x = "Assets", y = "Assets")
sum(is.na(port1ret))## [1] 0sum(is.na(port2ret))## [1] 0Plot Cumulative Returns for 10 stocks
chart.CumReturns(port1ret, main = "Cumulative Returns - R/R Portfolio10"
,wealth.index = TRUE
,legend.loc = TRUE
)
summary(port1ret)## Index acen allhc
## Min. :2015-01-09 Min. :-0.1550655 Min. :-0.2489676
## 1st Qu.:2017-04-18 1st Qu.:-0.0117896 1st Qu.:-0.0112890
## Median :2019-07-20 Median : 0.0000000 Median : 0.0000000
## Mean :2019-07-14 Mean : 0.0003544 Mean : 0.0004642
## 3rd Qu.:2021-10-11 3rd Qu.: 0.0101382 3rd Qu.: 0.0109291
## Max. :2023-12-29 Max. : 0.1498846 Max. : 0.3009273
## apx bpi cnpf
## Min. :-0.3815902 Min. :-1.156e-01 Min. :-0.3753499
## 1st Qu.:-0.0177436 1st Qu.:-8.654e-03 1st Qu.:-0.0073711
## Median : 0.0002012 Median : 0.000e+00 Median : 0.0000000
## Mean : 0.0000115 Mean : 9.376e-05 Mean : 0.0002986
## 3rd Qu.: 0.0191553 3rd Qu.: 9.227e-03 3rd Qu.: 0.0083136
## Max. : 0.2557048 Max. : 9.399e-02 Max. : 0.1479201
## cnvrg fgen jgs
## Min. :-0.1598487 Min. :-0.1060596 Min. :-0.1582695
## 1st Qu.:-0.0110959 1st Qu.:-0.0100268 1st Qu.:-0.0137192
## Median : 0.0000000 Median : 0.0000000 Median : 0.0000000
## Mean :-0.0002322 Mean :-0.0001861 Mean :-0.0002514
## 3rd Qu.: 0.0125452 3rd Qu.: 0.0087337 3rd Qu.: 0.0136237
## Max. : 0.1403574 Max. : 0.1323328 Max. : 0.1211960
## meg pxp
## Min. :-0.196549 Min. :-0.2536236
## 1st Qu.:-0.012540 1st Qu.:-0.0208346
## Median : 0.000000 Median :-0.0028531
## Mean :-0.000408 Mean :-0.0001148
## 3rd Qu.: 0.011696 3rd Qu.: 0.0148357
## Max. : 0.080852 Max. : 0.4054651boxplot(port1ret,main="Boxplot",las=2)
charts.PerformanceSummary(port1ret)
Plot Cumulative Returns for 20 stocks
chart.CumReturns(port2ret, main = "Cumulative Returns - Risk/Return Portfolio for 20 stocks"
,wealth.index = TRUE
,legend.loc = TRUE
)
charts.PerformanceSummary(port2ret)
Initiate the portfolio object
portf_10 <- portfolio.spec(assets = colnames((port1ret)))
portf_20 <- portfolio.spec(assets = colnames((port2ret)))Add constraints for full investment, long only positions, and weight constraints between 5% to 20% each asset) - 10 stocks
portf_10 <- add.constraint(portf_10, type = "full_investment")
portf_10 <- add.constraint(portf_10, type = "long_only")
portf_10 <- add.constraint(portf_10, type = "box", min = 0.0, max = 1.01)Add constraints for full investment, long only positions, and weight constraints between 3% to 10% each asset) - 20 stocks
portf_20 <- add.constraint(portf_20, type = "full_investment")
portf_20 <- add.constraint(portf_20, type = "long_only")
portf_20 <- add.constraint(portf_20, type = "box", min = 0.0, max = 1.01)Objectives for combination of risk and return - 10 stocks
# Objective to maximize return
portf_10 <- add.objective(portf_10, type = "return", name = "mean")
# Objective to minimize risk (standard deviation)
portf_10 <- add.objective(portf_10, type = "risk", name = "StdDev")Objectives for combination of risk and return - 20 stocks
# Objective to maximize return
portf_20 <- add.objective(portf_20, type = "return", name = "mean")
# Objective to minimize risk (standard deviation)
portf_20 <- add.objective(portf_20, type = "risk", name = "StdDev")Optimize Portfolio - 10 stocks
opt_10 <- PortfolioAnalytics::optimize.portfolio(port1ret
,portfolio = portf_10
,optimize_method = "ROI"
,trace = TRUE
)
print(opt_10)## ***********************************
## PortfolioAnalytics Optimization
## ***********************************
##
## Call:
## PortfolioAnalytics::optimize.portfolio(R = port1ret, portfolio = portf_10,
## optimize_method = "ROI", trace = TRUE)
##
## Optimal Weights:
## acen allhc apx bpi cnpf cnvrg fgen jgs meg pxp
## 0.2265 0.2491 0.0356 0.0952 0.3936 0.0000 0.0000 0.0000 0.0000 0.0000
##
## Objective Measure:
## mean
## 0.0003228
##
##
## StdDev
## 0.01426Optimization with Rebalancing - 10 stocks
opt_10_rebalanced <- optimize.portfolio.rebalancing(
R = port1ret
,portfolio = portf_10
,optimize_method = "ROI"
,rebalance_on = "years"
,trace = TRUE
)## Warning: executing %dopar% sequentially: no parallel backend registered# Extract and normalize weights
weights_10_rebalanced <- na.omit(extractWeights(opt_10_rebalanced))# Normalize weights if necessary
(weights_10_rebalanced <- weights_10_rebalanced / rowSums(weights_10_rebalanced, na.rm = TRUE))
# Extract the objective measures for the single period risk optimization with yearly rebalancing
(weights_10_rebalanced_objectivemeasures <- extractObjectiveMeasures(opt_10_rebalanced))Optimize Portfolio - 20 stocks
opt_20 <- optimize.portfolio(port2ret,
portfolio = portf_20
,optimize_method = "ROI"
,trace = TRUE
)
print(opt_20)## ***********************************
## PortfolioAnalytics Optimization
## ***********************************
##
## Call:
## optimize.portfolio(R = port2ret, portfolio = portf_20, optimize_method = "ROI",
## trace = TRUE)
##
## Optimal Weights:
## acen allhc apx bpi cnpf cnvrg fgen jgs meg pxp agi
## 0.0612 0.0934 0.0000 0.0000 0.0960 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
## ali bdo cbc ict mac nikl psei smc wlcon
## 0.0000 0.0000 0.0000 0.1599 0.0507 0.0000 0.0000 0.0000 0.5388
##
## Objective Measure:
## mean
## 0.000533
##
##
## StdDev
## 0.01451Extract Portfolio Weights for 20 stocks
weights_20 <- extractWeights(opt_20)
print(weights_20)## acen allhc apx bpi cnpf
## 6.116721e-02 9.335265e-02 -1.347283e-18 6.169855e-18 9.600612e-02
## cnvrg fgen jgs meg pxp
## 6.734642e-18 2.090088e-18 -1.431558e-17 -2.046154e-17 -1.609824e-17
## agi ali bdo cbc ict
## 1.240695e-16 -6.766506e-17 -3.451808e-17 1.033446e-16 1.599344e-01
## mac nikl psei smc wlcon
## 5.071763e-02 -5.836234e-18 1.796303e-16 -2.795006e-18 5.388220e-01Optimization with Rebalancing - 20 stocks
opt_20_rebalanced <- optimize.portfolio.rebalancing(
R = port2ret
,portfolio = portf_20
,optimize_method = "ROI"
,trace = TRUE
,search_size = 1000
,rebalance_on = "years"
)## Extract the objective measures for the single period risk optimization with Quarterly rebalancing
weights_20_rebalanced <- extractWeights(opt_20_rebalanced)
weights_20_rebalanced_objectivemeasures <- extractObjectiveMeasures(opt_20_rebalanced)Chart the optimal weights
chart.Weights(opt_10, plot.type = "bar")
chart.Weights(opt_20, plot.type = "bar")
#chart.Weights(opt_20_rebalanced, plot.type = "bar")
#chart.Weights(opt_10_rebalanced, plot.type = "bar")More detailed Charting for 10 stocks
chart.Weights(opt_10
,neighbors = NULL
,main = "Optimal Portfolio Weights - 10"
,las = 1
,xlab = "Stock"
,cex.lab = 1
,element.color = "darkgray"
,cex.axis = 0.8
,colorset = c("#e5F5F9", "#99D8C9")
,legend.loc = "topright"
,cex.legend = 0.5
,plot.type = "bar"
)
More detailed Charting for 20 stocks
chart.Weights(opt_20
,neighbors = NULL
,main = "Optimal Portfolio Weights - 20"
,las = 1
,xlab = "Stock"
,cex.lab = 1
,element.color = "darkgray"
,cex.axis = 0.8
,colorset = c("#e5F5F9", "#99D8C9")
,legend.loc = "topright"
,cex.legend = 0.5, plot.type = "bar"
)
weights_10 <- extractWeights(opt_10)
weights_20 <- extractWeights(opt_20)Calculate Portfolio Returns (for 10 & 20 stocks and with rebalancing)
portfolio_returns_10 <- Return.portfolio(R = port1ret, weights = weights_10)
portfolio_returns_10_rebalanced <- Return.portfolio(R = port1ret, weights = weights_10_rebalanced)
portfolio_returns_20 <- Return.portfolio(R = port2ret, weights = weights_20)
portfolio_returns_20_rebalanced <- Return.portfolio(R = port2ret, weights = weights_20_rebalanced)Comparison 10 stocks with Rebalancing vs No Rebalancing
allopt_10 <- merge(portfolio_returns_10, portfolio_returns_10_rebalanced)
colnames(allopt_10) <- c("Portfolio Returns (No Rebalancing)", "Portfolio Returns (With Rebalancing)")
print(colnames(allopt_10))## [1] "Portfolio Returns (No Rebalancing)"
## [2] "Portfolio Returns (With Rebalancing)"Comparison 20 stocks with Rebalancing vs No Rebalancing
allopt_20 <- merge(portfolio_returns_20, portfolio_returns_20_rebalanced)
colnames(allopt_20) <- c("Portfolio Returns (No Rebalancing)", "Portfolio Returns (With Rebalancing)")
print(colnames(allopt_20))## [1] "Portfolio Returns (No Rebalancing)"
## [2] "Portfolio Returns (With Rebalancing)"allopt_20## Portfolio.Returns..No.Rebalancing.
## 2015-01-12 0.0092553529
## 2015-01-13 0.0009066963
## 2015-01-14 0.0114188990
## 2015-01-19 -0.0023099613
## 2015-01-20 -0.0073899950
## 2015-01-22 0.0008196503
## 2015-01-26 0.0187129516
## 2015-01-27 -0.0049709190
## 2015-01-28 -0.0078509265
## 2015-01-30 -0.0001727150
## ...
## 2023-12-14 0.0005765688
## 2023-12-15 0.0171512798
## 2023-12-18 -0.0253386529
## 2023-12-19 0.0149420187
## 2023-12-20 0.0641663819
## 2023-12-21 -0.0279838016
## 2023-12-22 0.0090849615
## 2023-12-27 -0.0289857296
## 2023-12-28 0.0229102137
## 2023-12-29 -0.0061279321
## Portfolio.Returns..With.Rebalancing.
## 2015-01-12 NA
## 2015-01-13 NA
## 2015-01-14 NA
## 2015-01-19 NA
## 2015-01-20 NA
## 2015-01-22 NA
## 2015-01-26 NA
## 2015-01-27 NA
## 2015-01-28 NA
## 2015-01-30 NA
## ...
## 2023-12-14 0.004267135
## 2023-12-15 0.014847530
## 2023-12-18 -0.024145652
## 2023-12-19 0.013419834
## 2023-12-20 0.061093580
## 2023-12-21 -0.039100745
## 2023-12-22 0.021812839
## 2023-12-27 -0.028813749
## 2023-12-28 0.027278848
## 2023-12-29 -0.004995402Descriptive Statistics
summary_portfolio_returns_10 <- table.Stats(portfolio_returns_10$portfolio.returns)
summary_portfolio_returns_10_rebalanced <- table.Stats(portfolio_returns_10_rebalanced$portfolio.returns)
summary_portfolio_returns_20 <- table.Stats(portfolio_returns_20$portfolio.returns)
summary_portfolio_returns_20_rebalanced <- table.Stats(portfolio_returns_20_rebalanced$portfolio.returns)all_port_returns <- merge(portfolio_returns_10, portfolio_returns_10_rebalanced, portfolio_returns_20, portfolio_returns_20_rebalanced)
all_port_returns_corr <- data.frame(
portfolio_returns_10 = rnorm(100)
,portfolio_returns_10_rebalanced = rnorm(100)
,portfolio_returns_20 = rnorm(100)
,portfolio_returns_20_rebalanced = rnorm(100)
)correlation_matrix <- cor(all_port_returns_corr)
print(correlation_matrix)## portfolio_returns_10
## portfolio_returns_10 1.00000000
## portfolio_returns_10_rebalanced 0.05762080
## portfolio_returns_20 -0.08998345
## portfolio_returns_20_rebalanced 0.16453572
## portfolio_returns_10_rebalanced
## portfolio_returns_10 0.05762080
## portfolio_returns_10_rebalanced 1.00000000
## portfolio_returns_20 0.02952847
## portfolio_returns_20_rebalanced 0.12266984
## portfolio_returns_20
## portfolio_returns_10 -0.08998345
## portfolio_returns_10_rebalanced 0.02952847
## portfolio_returns_20 1.00000000
## portfolio_returns_20_rebalanced 0.06415643
## portfolio_returns_20_rebalanced
## portfolio_returns_10 0.16453572
## portfolio_returns_10_rebalanced 0.12266984
## portfolio_returns_20 0.06415643
## portfolio_returns_20_rebalanced 1.00000000corrplot(correlation_matrix, method = "color")
melted_correlation_matrix <- melt(correlation_matrix)
ggplot(melted_correlation_matrix, aes(x=Var1, y=Var2, fill=value)) +
geom_tile() +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0) +
theme_minimal() +
labs(title = "Correlation Matrix Heatmap", x = "Assets", y = "Assets")
Plot Cumulative Returns for 10 stocks
chart.CumReturns(portfolio_returns_10, main = "Cumulative Returns - R/R Port10", wealth.index = TRUE)
charts.PerformanceSummary(portfolio_returns_10)
Plot Cumulative Returns for 20 stocks
chart.CumReturns(portfolio_returns_20, main = "Cumulative Returns - R/R Port20", wealth.index = TRUE)
charts.PerformanceSummary(portfolio_returns_20)
# Plot Cumulative Returns for 10 stocks with rebalancing
chart.CumReturns(portfolio_returns_10_rebalanced, main = "Cumulative Returns - R/R Port10 w rebalancing", wealth.index = TRUE)
charts.PerformanceSummary(portfolio_returns_10_rebalanced)
Plot Cumulative Returns for 20 stocks with rebalancing
chart.CumReturns(portfolio_returns_20_rebalanced, main = "Cumulative Returns - R/R Port20 w rebalancing", wealth.index = TRUE)
charts.PerformanceSummary(portfolio_returns_20_rebalanced)
Efficient Frontier for 10 stocks
Function to generate multiple points on the efficient frontier
generate_efficient_frontier_10 <- function(port1ret, portf_10, num_points = 50) {
eff_frontier <- data.frame(Return = numeric(), Risk = numeric(), SharpeRatio = numeric())
min_return <- min(colMeans(port1ret, na.rm = TRUE))
max_return <- max(colMeans(port1ret, na.rm = TRUE))
target_returns <- seq(min_return, max_return, length.out = num_points)
for (target_return in target_returns) {
tmp_portfolio <- portf_10
tmp_portfolio <- add.constraint(tmp_portfolio, type = "return", return_target = target_return)
tmp_portfolio <- add.objective(tmp_portfolio, type = "risk", name = "StdDev")
opt <- optimize.portfolio (R = port1ret, portfolio = tmp_portfolio, optimize_method = "ROI", trace = TRUE)
ret <- mean(Return.portfolio(R = port1ret, weights = extractWeights(opt)))
risk <- StdDev(Return.portfolio(R = port1ret, weights = extractWeights(opt)))
sharpe <- ret/risk
eff_frontier <- rbind(eff_frontier, data.frame(Return = ret, Risk = risk, SharpeRatio = sharpe))
}
return(eff_frontier)
}Generate efficient frontier
efficient_frontier <- generate_efficient_frontier_10(port1ret, portf_10, num_points = 100)Plot efficient frontier
plot(efficient_frontier$Risk
,efficient_frontier$Return
,type = "l"
,col="black"
,lwd = 1
,xlab = "Risk (StdDev)"
,ylab = "Return"
,main = "Efficient Frontier"
)
points(efficient_frontier$Risk
,efficient_frontier$Return
,col = "grey"
# ,pch = 16
)
EF 20
generate_efficient_frontier_20 <<- function(port2ret, portf_20, num_points = 50) {
eff_frontier <<- data.frame(Return = numeric(), Risk = numeric(), SharpeRatio = numeric())
min_return <<- min(colMeans(port2ret, na.rm = TRUE))
max_return <<- max(colMeans(port2ret, na.rm = TRUE))
target_returns <- seq(min_return, max_return, length.out = num_points)
for (target_return in target_returns) {
tmp_portfolio <<- portf_20
tmp_portfolio <<- add.constraint(tmp_portfolio, type = "return", return_target = target_return)
tmp_portfolio <<- add.objective(tmp_portfolio, type = "risk", name = "StdDev")
opt <<- optimize.portfolio(R = port2ret, portfolio = tmp_portfolio, optimize_method = "ROI", trace = TRUE)
ret <<- mean(Return.portfolio(R = port2ret, weights = extractWeights(opt)))
risk <<- StdDev(Return.portfolio(R = port2ret, weights = extractWeights(opt)))
sharpe <<- ret/risk
eff_frontier <<- rbind(eff_frontier, data.frame(Return = ret, Risk = risk, SharpeRatio = sharpe))
}
return(eff_frontier)
}Generate efficient frontier
efficient_frontier <- generate_efficient_frontier_20(port2ret, portf_20, num_points = 100)## Warning in Return.portfolio.geometric(R = R, weights = weights, wealth.index =
## wealth.index, : The weights for one or more periods do not sum up to 1:
## assuming a return of 0 for the residual weights
## Warning in Return.portfolio.geometric(R = R, weights = weights, wealth.index =
## wealth.index, : The weights for one or more periods do not sum up to 1:
## assuming a return of 0 for the residual weightsPlot efficient frontier
plot(efficient_frontier$Risk
,efficient_frontier$Return
,type = "l"
,col="black"
,lwd = 2
,xlab = "Risk (StdDev)"
,ylab = "Return"
,main = "Efficient Frontier"
)
points(efficient_frontier$Risk
,efficient_frontier$Return
,col = "gray"
# ,pch = 16
)